Your Choice 1/your choice.zip/your choice/PRGMMING/VISIONIX/VDOSHU.PAS

Pascal/Delphi Source File | 1993-12-23 | 50KB | 2,773 lines

{
════════════════════════════════════════════════════════════════════════════

 Visionix DOS High-Level Functions Unit (VDOSHIGH)
   Version 0.5
 Copyright 1991,92,93 Visionix
 ALL RIGHTS RESERVED

────────────────────────────────────────────────────────────────────────────

 Revision history in reverse chronological order:

 Initials  Date      Comment
 --------  --------  -------------------------------------------------------

  jrt      10/27/93  Moved code from VDOS into here.
   \
    \
     lpg       03/25/93  Fixed DOS_GetMediaID, DOS_SetMediaID and made sure
                           they indicated the Drive Number.

     lpg       03/15/93  Added Source Documentation

     mep       02/11/93  Cleaned up code for beta release

     jrt       02/08/93  Sync with beta 0.12 release

     lpg       12/08/92  Created


  jrt      10/13/93  Added GetDirFromPath, GetNameFromPath,
                     GetExtFromPath, RemoveExtraSlash.

  mep      04/25/93  Added DeviceExist

  rag      04/22/93  Added DriveExist.

  lpg      03/25/93  Added: GetVolLabel,GetFileSysType

  lpg      03/15/93  Added Source Documentation

  jrt      03/08/93  First logged revision.  Took functions from VGEn
                     and moved them here.

════════════════════════════════════════════════════════════════════════════
}

(*-

[SECTION: Section 3: Operating System Services]
[CHAPTER: Chapter 1: The DOS High-level functions unit]

[TEXT]

<Overview>

The VDOSHu unit implements various DOS oriented functions.

More documentation will be added to this unit in the next BETA
release.

<Interface>

-*)


UNIT VDOSHu;


Interface

Uses

  DOS,
  VTypesu,
  VGenu;

{────────────────────────────────────────────────────────────────────────────}


{------------------}
{ Diskette and DOS }
{------------------}

Procedure DOS_GetData(        Var Version        : WORD;
                              Var OEM            : BYTE;
                              Var Serial         : LONGINT   );

Function  DOS_GetVersion                                       : WORD;

Function  DOS_GetOEM                                           : BYTE;

Function  DOS_GetSerial                                        : LONGINT;

Function  DOS_GetStartupDrive                                  : BYTE;

Function  DOS_GetMSDOSVersion(Var DosInHMA       : BOOLEAN;
                              Var Revision       : BYTE      ) : WORD;

Function  DOS_GetDiskSpaceFree(   Drive          : BYTE      ) : LONGINT;

Function  DOS_GetDevInputStatus(  Handle         : WORD;
                              Var Status         : BYTE      ) : BYTE;

Function  DOS_GetDevOutputStatus( Handle         : WORD;
                              Var Status         : BYTE      ) : BYTE;

Function  DOS_IsRemovMediaDev(    Drive          : BYTE;
                              Var Remov          : BOOLEAN   ) : WORD;

Function  DOS_GetMediaID(         Drive          : BYTE;
                              Var InfoLevel      : WORD;
                              Var SerialNbr      : LONGINT;
                              Var VolLabel       : STRING;
                              Var FileSysType    : STRING    ) : WORD;

Function  DOS_SetMediaID(         Drive          : BYTE;
                                  InfoLevel      : WORD;
                                  SerialNbr      : LONGINT;
                                  VolLabel       : STRING;
                                  FileSysType    : STRING    ) : WORD;

Function  DOS_GetExtErrText(  VAR Description    : STRING;
                              VAR ErrCause       : STRING;
                              VAR Recommend      : STRING;
                              VAR ErrSource      : STRING    ) : WORD;




Function  GetDOSVersion                        : WORD;

Function  DisketteStatus(            Drive     : WORD    ) : BYTE;

Function  FloppyReady(               Drive     : WORD    ) : BOOLEAN;

Function  PutSlash(                  S         : STRING  ) : STRING;

Function  UnPutSlash(                S         : STRING  ) : STRING;

Function  PutDot(                    S         : STRING  ) : STRING;

Function  UnPutDot(                  S         : STRING  ) : STRING;

Function  FileExist(                 fn        : PathStr ) : BOOLEAN;

Function  GetFileTime(               fn        : PathStr ) : LONGINT;

Function  GetFileAttr(               fn        : PathStr ) : WORD;

Function  GetFileSize(               fn        : PathStr ) : LONGINT;

Function  DirExist(                  stDir     : DirStr  ) : BOOLEAN;

Function  DirEmpty(                  stDir     : DirStr  ) : BOOLEAN;

Function  EraseDir(                  stDir     : DirStr  ) : BOOLEAN;

Function  PredDir(                   stDir     : DirStr  ) : DirStr;

Function  InDir(                     stDir     : DirStr  ) : DirStr;

Procedure MkSubDir(                  S         : STRING  );

Function  MaskWildcards(             fn        : PathStr;
                                     fnMask    : PathStr ) : PathStr;

Procedure FileCRC16(                 FName     : STRING;
                                 Var Result    : WORD    );

Procedure FileCRC32(                 FName     : STRING;
                                 Var Result    : LONGINT );

Function  GetVolLabel(               Drive     : BYTE    ) : STRING;

Function  GetFileSysType(            Drive     : BYTE    ) : STRING;

Function  DriveExist(                Drive     : CHAR    ) : BOOLEAN;

Function  DeviceExist(               Name      : STRING  ) : BOOLEAN;

(*
Function  TextSeek(              Var F         : Text;
                                     Target    : LongInt ) : Boolean;
*)

Function  GetDirFromPath(            Path      : STRING  ) : STRING;
Function  GetNameFromPath(           Path      : STRING  ) : STRING;
Function  GetExtFromPath(            Path      : STRING  ) : STRING;

Function  RemoveExtraSlash(          Path      : STRING  ) : STRING;


{────────────────────────────────────────────────────────────────────────────}

Implementation

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure DOS_GetData(        Var Version        : WORD;
                              Var OEM            : BYTE;
                              Var Serial         : LONGINT   );

[PARAMETERS]

Version     VAR Returned Dos Version
OEM         VAR Returned Dos OEM Code
Serial      VAR Returned Dos Serial Number

[RETURNS]

(Function : None)
(VAR : [Version] Dos Version)
(VAR : [OEM] Dos OEM Code)
(VAR : [Serial] Dos Serial Number)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure DOS_GetData(        Var Version        : WORD;
                              Var OEM            : BYTE;
                              Var Serial         : LONGINT   );

{$IFNDEF OS2}

Assembler;
ASM

  PUSH DS

  MOV  AH, $30
  INT  $21

  LES  DI, [Version]
  LDS  SI, [OEM]
  MOV  word PTR ES:DI, AX         { Version }
  MOV  byte PTR DS:SI, BH         { OEM Code }

  LES  SI, [Serial]
  XOR  BH, BH
  MOV  word PTR ES:DI, BX         { High Order Word of Serial }
  MOV  word PTR ES:DI+4, CX       { Low Order Word of serial  }

  POP  DS

END;  { DOS_GetData }

{$ELSE}

BEGIN

  Version := 200;
  OEM     := 99;
  Serial  := 1010101;

  {!^!}

END;

{$ENDIF}

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function DOS_GetVersion                                        : WORD;

[PARAMETERS]

(None)

[RETURNS]

Dos Version

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function DOS_GetVersion                                        : WORD;

Var

  Version : WORD;
  OEM     : BYTE;
  Serial  : LONGINT;

BEGIN

  DOS_GetData( Version, OEM, Serial );
  DOS_GetVersion := Version;

END;  { DOS_GetVresion }

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function DOS_GetOEM                                            : BYTE;

[PARAMETERS]

(None)

[RETURNS]

Dos OEM Code

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function DOS_GetOEM                                            : BYTE;

Var

  Version : WORD;
  OEM     : BYTE;
  Serial  : LONGINT;

BEGIN

  DOS_GetData( Version, OEM, Serial );
  DOS_GetOEM := OEM;

END;  { DOS_GetOEM }

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function DOS_GetSerial                                         : LONGINT;

[PARAMETERS]

(None)

[RETURNS]

Dos Serial Number

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function DOS_GetSerial                                         : LONGINT;

Var

  Version : WORD;
  OEM     : BYTE;
  Serial  : LONGINT;

BEGIN

  DOS_GetData( Version, OEM, Serial );
  DOS_GetSerial := Serial;

END;  { DOS_GetSerial }

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function DOS_GetStartupDrive                                   : BYTE;

[PARAMETERS]

(None)

[RETURNS]

Start up Drive Number (1=A,2=B,...)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function DOS_GetStartupDrive                                   : BYTE;

{$IFNDEF OS2}

Assembler;
ASM

  MOV  AH, $33
  MOV  AL, $05
  INT  $21

  MOV  AL, DL

END;  { DOS_GetStartupDrive }

{$ELSE}

BEGIN

  DOS_GetStartupDrive := 2;

END;

{$ENDIF}

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function DOS_GetMSDOSVersion( Var DosInHMA       : BOOLEAN;
                              Var Revision       : BYTE      ) : WORD;

[PARAMETERS]

DosInHMA    VAR Returned Is DOS Loaded in High Memory?
Revision    VAR Returned DOS Revision

[RETURNS]

(Function : Operation Error Code) (0=Success)
(VAR      : [DosInHMA] Is DOS Loaded in High Memory?)
(VAR      : [Revision] DOS Revision)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function DOS_GetMSDOSVersion( Var DosInHMA       : BOOLEAN;
                              Var Revision       : BYTE      ) : WORD;

{$IFNDEF OS2}

Assembler;
ASM


  MOV  AH, $33
  MOV  AL, $06
  INT  $21

  PUSH DS
  PUSH ES

  LES  DI, [DosInHMA]
  LDS  SI, [Revision]

  AND  DL, $07
  MOV  byte PTR DS:SI, DL

  CMP  DH, $10
  JNE  @@1

  MOV  byte PTR ES:DI, $01   { DosInHMA = TRUE }
  JMP  @@2

 @@1:
  MOV  byte PTR ES:DI, $00   { DosInHMA = FALSE }

 @@2:

  POP  ES
  POP  DS

END;  { DOS_GetMSDOSVersion }

{$ELSE}

BEGIN

END;

{$ENDIF}

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function DOS_GetDiskSpaceFree(    Drive          : BYTE      ) : LONGINT;

[PARAMETERS]

Drive       Drive Number (+80h for HD)

[RETURNS]

Free Space on Selected Drive

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function DOS_GetDiskSpaceFree(    Drive          : BYTE      ) : LONGINT;

{$IFNDEF OS2}

Var

  SPC,BPS,
  AvailClust,
  ClustPDrv  : WORD;

BEGIN

  ASM

    MOV  DL, Drive
    MOV  AH, $36
    INT  $21

    MOV  SPC, AX
    MOV  AvailClust, BX
    MOV  BPS, CX
    MOV  ClustPDrv, DX

  END;

  DOS_GetDiskSpaceFree := LONGINT( SPC ) * LONGINT( AvailClust ) *
                          LONGINT( BPS ) * LONGINT( ClustPDrv );

END;  { DOS_GetDiskSpaceFree }

{$ELSE}

BEGIN

END;

{$ENDIF}


{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function DOS_GetDevInputStatus( Handle    : WORD;
                            Var Status    : BYTE      ) : BYTE;

[PARAMETERS]

Handle      Device or File Handle
Status      VAR Returned Device or File Input Status Code

[RETURNS]

(Function : Operation Error Code) (0=Success)
(VAR      : [Status] Device or File Input Status Code)

[DESCRIPTION]

Status returns as follows:

  Devices:  $00 = Not Ready,      $FF = Ready
  Files  :  $00 = Pointer at EOF, $FF = Ready

[SEE-ALSO]

[EXAMPLE]

-*)

Function DOS_GetDevInputStatus( Handle    : WORD;
                            Var Status    : BYTE      ) : BYTE;


{$IFNDEF OS2}

Assembler;
ASM

  MOV  BX, Handle
  MOV  AH, $44
  MOV  AL, $06
  INT  $21

  LES  DI, [Status]

  JNC  @@1

  MOV  AL, AH                { Code = Error }
  MOV  byte PTR ES:DI, $00
  JMP  @@2

 @@1:
  MOV  byte PTR ES:DI, AL    { Status = Result }
  XOR  AL, AL                { Code = No Error }

 @@2:

END;  { DOS_GetDevInputStatus }

{$ELSE}

BEGIN

  {!^!}

END;

{$ENDIF}

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function DOS_GetDevOutputStatus(  Handle         : WORD;
                              Var Status         : BYTE      ) : BYTE;

[PARAMETERS]

Handle      Device or File Handle
Status      VAR Returned Device or File Output Status Code

[RETURNS]

(Function : Operation Error Code) (0=Success)
(VAR      : [Status] Device or File Output Status Code)

[DESCRIPTION]

Status returns as follows:

   Devices:  $00 = Not Ready,  $FF = Ready
   Files  :  $00 = Ready,      $FF = Ready

[SEE-ALSO]

[EXAMPLE]

-*)

Function DOS_GetDevOutputStatus(  Handle         : WORD;
                              Var Status         : BYTE      ) : BYTE;


{$IFNDEF OS2}

Assembler;
ASM

  MOV  BX, Handle
  MOV  AH, $44
  MOV  AL, $07
  INT  $21

  LES  DI, [Status]

  JNC  @@1

  MOV  AL, AH                { Code = Error }
  MOV  byte PTR ES:DI, $00
  JMP  @@2

 @@1:
  MOV  byte PTR ES:DI, AL    { Status = Result }
  XOR  AL, AL                { Code = No Error }

 @@2:

END;  { DOS_GetDevOutputStatus }

{$ELSE}

BEGIN

  {!^!}

END;

{$ENDIF}


{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function DOS_IsRemovMediaDev(     Drive          : BYTE;
                              Var Remov          : BOOLEAN   ) : WORD;

[PARAMETERS]

Drive       Selected Drive Number
Remov       VAR Returned Is Media Removable? (TRUE=Yes)

[RETURNS]

(Function : Operation Error Code)
(VAR      : [Remov] Is Media Removable?)

[DESCRIPTION]

Tests if Device is a Removable Media Device and returns the Results.
TRUE=Removable Media Device, FALSE=Fixed Media Device

[SEE-ALSO]

[EXAMPLE]

-*)

{----------------------------------------------------------}
{                  Function DOS_IsRemovMediaDev            }
{----------------------------------------------------------}
{ IN : Drive (BYTE) Drive Number (+80h for HD)             }
{  Var Remov (BOOLEAN) Returned Is Drive's Media Removable?}
{ OUT: (WORD) Error Code                                   }
{----------------------------------------------------------}

Function DOS_IsRemovMediaDev(     Drive          : BYTE;
                              Var Remov          : BOOLEAN   ) : WORD;

{$IFNDEF OS2}

Assembler;
ASM

  MOV  BL, Drive
  MOV  AH, $44
  MOV  AL, $08
  INT  $21

  LES  DI, [Remov]

  JNC @@1

  MOV  byte PTR ES:DI, $00   { Code = Error, Remov = Void }
  Jmp  @@2

 @@1:
  CMP  AL, 0
  JNZ  @@1A

  MOV  byte PTR ES:DI, $01   { Remov = TRUE }
  XOR  AX, AX                { Code = No Error }
  JMP  @@2

 @@1A:
  MOV  byte PTR ES:DI, $00   { Remov = FALSE }
  XOR  AX, AX                { Code = No Error }

 @@2:

END;

{$ELSE}

BEGIN

 DOS_IsRemovMediaDev := $00; {!^!}

END;

{$ENDIF}

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function DOS_GetMediaID(          Drive          : BYTE;
                              Var InfoLevel      : WORD;
                              Var SerialNbr      : LONGINT;
                              Var VolLabel       : STRING;
                              Var FileSysType    : STRING    ) : WORD;


[PARAMETERS]

Drive       Drive Number
InfoLevel   VAR Returned Information Access Level
SerialNbr   VAR Returned Media Serial Number
VolLabel    VAR Returned Media Volume Label
FileSysType VAR Returned Media File System Type

[RETURNS]

(Function : Operation Error Code)
(VAR      : [InfoLevel] Information Access Level)
(VAR      : [SerialNbr] Media Serial Number)
(VAR      : [VolLabel] Media Volume Label)
(VAR      : [FileSysType] Media File System Type)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

{----------------------------------------------------------}
{                  Function DOS_GetMediaID                 }
{----------------------------------------------------------}
{ IN :                                                     }
{ OUT:                                                     }
{----------------------------------------------------------}

Function DOS_GetMediaID(          Drive          : BYTE;
                              Var InfoLevel      : WORD;
                              Var SerialNbr      : LONGINT;
                              Var VolLabel       : STRING;
                              Var FileSysType    : STRING    ) : WORD;


{$IFNDEF OS2}

Type

  TMID = RECORD

    InfoLevel   : WORD;
    SerialNbr   : LONGINT;
    VolLabel    : ARRAY[1..11] of CHAR;
    FileSysType : ARRAY[1..8] of BYTE;

  END;

Var
  R   : REGISTERS;
  MID : TMID;
  Err : WORD;
  i   : INTEGER;

BEGIN
(*
  ASM

    LDS  DX, MID
    MOV  AH, $44
    MOV  AL, $0D
    MOV  CH, $08
    MOV  CL, $66
    INT  $21

    JNC @@1

    MOV  Err, AX             { Status = Error }
    JMP  @@2

   @@1:
    MOV  Err, 0              { Status = No Error }

   @@2:

  END;
*)

  R.AH := $44;
  R.AL := $0D;
  R.BX := Drive;
  R.CH := $08;
  R.CL := $66;
  R.DX := Ofs( MID );
  R.DS := Seg( MID );
  Intr( $21, R );

  If NOT Odd( R.Flags ) Then
  BEGIN

    InfoLevel := MID.InfoLevel;
    SerialNbr := MID.SerialNbr;

    Move ( MID.VolLabel, VolLabel[1], 11 );
    VolLabel[0] := #11;
    i := Pos( #0, VolLabel );
    If ( i > 0 )  Then
      VolLabel[0] := CHAR( i-1 );

    Move( MID.FileSysType, FileSysType[1], 8 );
    FileSysType[0] := #8;

    DOS_GetMediaID := 0;

  END  { If Odd }

  Else
  BEGIN

    InfoLevel   := 0;
    SerialNbr   := 0;
    VolLabel    := '';
    FileSysType := '';

    DOS_GetMediaID := R.AX;

  END;  { If Odd / Else }

END;  { DOS_GetMediaID }

{$ELSE}

BEGIN

  DOS_GetMediaID := $FFFF;  {!^!}

END;

{$ENDIF}

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function DOS_SetMediaID(          Drive          : BYTE;
                                  InfoLevel      : WORD;
                                  SerialNbr      : LONGINT;
                                  VolLabel       : STRING;
                                  FileSysType    : STRING    ) : WORD;

[PARAMETERS]

Drive       Drive Number
InfoLevel   Information Access Level
SerialNbr   Media Serial Number
VolLabel    Media Volume Label
FileSysType Media File System Type

[RETURNS]

Operation Error Code ($0000=Success)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function DOS_SetMediaID(          Drive          : BYTE;
                                  InfoLevel      : WORD;
                                  SerialNbr      : LONGINT;
                                  VolLabel       : STRING;
                                  FileSysType    : STRING    ) : WORD;

{$IFNDEF OS2}

Type

  TMID = RECORD

    InfoLevel   : WORD;
    SerialNbr   : LONGINT;
    VolLabel    : ARRAY[1..11] of CHAR;
    FileSysType : ARRAY[1..8] of BYTE;

  END;

Var

  MID : TMID;
  Err : WORD;
  i   : INTEGER;
  R   : REGISTERS;

BEGIN

  MID.InfoLevel := InfoLevel;
  MID.SerialNbr := SerialNbr;

  Move( VolLabel[1], MID.VolLabel[1], 11 );
  If BYTE( VolLabel[0] ) < 11 Then
  BEGIN

    For i := BYTE( VolLabel[0] ) to 11 Do
      MID.VolLabel[ i ] := #0;

  END;

  Move( FileSysType[1], MID.FileSysType[1], 8 );
  If BYTE( FileSysType[0] ) < 8 Then
  BEGIN

    For i := BYTE( FileSysType[0] ) to 8 Do
      MID.FileSysType[ i ] := 0;

  END;

  R.AH := $44;
  R.AL := $0D;
  R.BX := Drive;
  R.CH := $08;
  R.CL := $46;
  R.DX := Ofs( MID );
  R.DS := Seg( MID );

(*
  ASM

    PUSH DS

    LDS  DX, MID
    MOV  AH, $44
    MOV  AL, $0D
    MOV  CH, $08
    MOV  CL, $46
    INT  $21

    JNC @@1

    MOV  Err, AX             { Status = Error }
    JMP  @@2

   @@1:
    MOV  Err, 0              { Status = No Error }

   @@2:

    POP  DS

  END;
*)

  If NOT Odd( R.Flags ) Then
    DOS_SetMediaID := 0
  Else
    DOS_SetMediaID := R.AX;

END;  { DOS_SetMediaID }


{$ELSE}

BEGIN

  DOS_SetMediaID := $FFFF; {!^!}

END;


{$ENDIF}
{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function DOS_GetExtErrText(   VAR Description    : STRING;
                              VAR ErrCause       : STRING;
                              VAR Recommend      : STRING;
                              VAR ErrSource      : STRING    ) : WORD;

[PARAMETERS]

Description VAR Returned Error Description Text
ErrCause    VAR Returned Error Cause Text
Recommend   VAR Returned Error Recommendation Text
ErrSource   VAR Returned Error Source Text

[RETURNS]

(Function : Operation Error Code, $0000=Success)
(VAR      : [Description] Error Description Text)
(VAR      : [ErrCause] Error Cause Text)
(VAR      : [Recommend] Error Recommendation Text)
(VAR      : [ErrSource] Error Source Text)

[DESCRIPTION]

Reads the Extended DOS Error Information for the last Error Condition
and returns the above information about it.

Based upon the Error Code, Returns each of the following:
  1) A Description of the Error Condition
  2) What may have Caused the Problem
  3) A Suggested Course of Action
  4) Device in which Error Occurred.

[SEE-ALSO]

[EXAMPLE]

-*)

Function DOS_GetExtErrText(   VAR Description    : STRING;
                              VAR ErrCause       : STRING;
                              VAR Recommend      : STRING;
                              VAR ErrSource      : STRING    ) : WORD;


{$IFNDEF OS2}

Var

  R : REGISTERS;

BEGIN

  { The following Registers are NOT preserved }
  { Used      = AX, BX, CH                    }
  { Destroyed = CL, DX, BP, SI, DI, DS, ES    }

  R.AH := $59;
  Intr( $21, R );

  Case R.AX Of
     0 : Description := 'No Error';
     1 : Description := 'Invalid Function Number';
     2 : Description := 'File Not Found';
     3 : Description := 'Path Not Found';
     4 : Description := 'Too Many Files Open';
     5 : Description := 'Access Denied';
     6 : Description := 'Invalid Handle';
     7 : Description := 'Memory Control Block Destroyed';
     8 : Description := 'Insufficient Memory';
     9 : Description := 'Invalid Memory Address';
    10 : Description := 'Invalid Environment';
    11 : Description := 'Invalid Format';
    12 : Description := 'Invalid Access Code';
    13 : Description := 'Invalid Data';
    14 : Description := 'Reserved';
    15 : Description := 'Invalid Drive';
    16 : Description := 'Current Directory Cannot be Removed';
    17 : Description := 'Different Device';
    18 : Description := 'No Additional Files';
    19 : Description := 'Medium Write Protected';
    20 : Description := 'Unknown Device';
    21 : Description := 'Device Not Ready';
    22 : Description := 'Unknown Command';
    23 : Description := 'CRC Error';
    24 : Description := 'Bad Request Structure Length';
    25 : Description := 'Seek Error';
    26 : Description := 'Unknown Medium Type';
    27 : Description := 'Sector Not Found';
    28 : Description := 'Printer Out of Paper';
    29 : Description := 'Write Error';
    30 : Description := 'Read Error';
    31 : Description := 'General Failure';
    32 : Description := 'Sharing Violation';
    33 : Description := 'Lock Violation';
    34 : Description := 'Unanthorized Disk Change';
    35 : Description := 'FCB Not Available';
    80 : Description := 'File Already Exists';
    81 : Description := 'Reserved';
    82 : Description := 'Directory Cannot be Created';
    83 : Description := 'Terminate After Call of Interrupt 24h';
  End;  { Case AX }

  Case R.BH Of
     1 : ErrCause := 'No Memory on the Medium';
     2 : ErrCause := 'Tempory Access Problem - May End Soon';
     3 : ErrCause := 'Access Unauthorized';
     4 : ErrCause := 'Internal Error in System Software';
     5 : ErrCause := 'Hardware Error';
    16 : ErrCause := 'Software Failure Not Caused by Running Application Program';
    17 : ErrCause := 'Application Program Error';
    18 : ErrCause := 'File Not Found';
    19 : ErrCause := 'Invalid File Format/Type';
    10 : ErrCause := 'File Locked';
    11 : ErrCause := 'Wrong Medium in Drive, Bad Disk or Medium Problem';
    12 : ErrCause := 'Other Error';
  End;  { Case BH }

  Case R.BL Of
     1 : Recommend := 'Repeat Process Several Times, Then Ask User to Abort/Ignore';
     2 : Recommend := 'Repeat Process Several Times Pausing Each Time, Then Ask User to Abort/Retry';
     3 : Recommend := 'Ask User for Correct Information (eg. Filename)';
     4 : Recommend := 'Terminate Program as Completely as Possible';
     5 : Recommend := 'Terminate Program NOW (No File Closing, etc)';
     6 : Recommend := 'Ignore Error';
     7 : Recommend := 'Ask User to Remove Error Source and Repeat Process';
  End;  { Case BL }

  Case R.CH Of
     1 : ErrSource := 'Unknown';
     2 : ErrSource := 'Block Device (Disk Drive, Hard Disk, etc)';
     3 : ErrSource := 'Network';
     4 : ErrSource := 'Serial Device';
     5 : ErrSource := 'RAM';
  End;  { Case CH }

END;  { DOS_GetExtErrText }

{$ELSE}

BEGIN

  Description := '<Info not available in OS/2>'; {!^!}
  ErrCause    := '';
  ErrSource   := '';

END;

{$ENDIF}


{-

[FUNCTION]

Function  GetDOSVersion                        : BYTE;

[PARAMETERS]

(None)

[RETURNS]

DOS version in BCD format

[DESCRIPTION]

Returns the Binary Coded Decimal format of the DOS Version

[SEE-ALSO]

[EXAMPLE]

-}



Function GetDOSVersion                         : WORD;

{$IFNDEF OS2}

Var

  R : REGISTERS;

BEGIN

  R.AH := $30;
  R.ES := $00;  { Load with 00 to avoid GPF in win/dpmi }
  R.DS := $00;

  Intr( $21, R );
  GetDosVersion := R.AL * 10 + R.AH;

END;

{$ELSE}

BEGIN

  GetDosVersion := 200; {!^!}

END;


{$ENDIF}

{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Function  DisketteStatus(            DriveA    : BOOLEAN ) : BYTE;

[PARAMETERS]

DriveA      Is test for Drive A: ? (A: = TRUE, B: = FALSE)

[RETURNS]

Floppy Drive Status code

[DESCRIPTION]

Tests the given Floppy Drive and returns the Status Code as follows:
     00h = diskette change signal not active (diskette not replaced)
     01h = invalid diskette parameter (disketted formatted?)
     06h = diskette change signal active (diskette replaced?)
     80h = diskette drive not ready (diskette in drive?)

[SEE-ALSO]

FloppyReady

[EXAMPLE]

-}


Function DisketteStatus(             Drive     : WORD   ) : BYTE;

{$IFNDEF OS2}

Var

  R : REGISTERS;

BEGIN

  R.AH := $16;

  R.DL := Drive;

  R.DS := 0;
  R.ES := 0;

  Intr( $13, R );

  DisketteStatus := R.AH;

END;

{$ELSE}

BEGIN

  DisketteStatus := $FF { !^! }

END;

{$ENDIF}

{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Function  FloppyReady(               DriveA    : BOOLEAN ) : BOOLEAN;

[PARAMETERS]

DriveA      Is test for Drive A: ? (A: = TRUE, B: = FALSE)

[RETURNS]

Whether the desired floppy drive was ready for use

[DESCRIPTION]

Test the given Floppy Drive to determine if the Drive was ready
for use (IE Drive accessable and Diskette is in the Drive) and
returns the results.

[SEE-ALSO]

DisketteStatus

[EXAMPLE]

-}


Function FloppyReady(                Drive     : WORD    ) : BOOLEAN;

Const

  cInvalidParam    = $01;
  cChgSignalActive = $06;
  cDriveNotReady   = $80;

Var

  Count  : INTEGER;
  Status : BYTE;

BEGIN

  Count := 0;

  Repeat

    Status := DisketteStatus( Drive );
    Inc( Count );

  Until (Status <> cChgSignalActive) or (Count >= 3);

  FloppyReady := (Status <> cDriveNotReady) AND
                 (Status <> cChgSignalActive);

END;

{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Function  PutSlash(                  S         : STRING  ) : STRING;

[PARAMETERS]

S           Source String to modify

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

UnPutSlash
PutDot
UnPutDot

[EXAMPLE]

-}

Function PutSlash(                     S         : STRING       ) : STRING;

BEGIN

  If ( S[0] = #0 ) OR
     ( S[Byte(S[0])] = ':' ) OR
     ( S[Byte(S[0])] = '\' ) Then
    PutSlash := S
  Else
    PutSlash := S + '\';

END;

{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Function  UnPutSlash(                S         : STRING  ) : STRING;

[PARAMETERS]

S           Source String to modify

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

PutSlash
PutDot
UnPutDot

[EXAMPLE]

-}

Function UnPutSlash(                   S         : STRING       ) : STRING;

BEGIN

  If (S[0] > #0) AND
     (S[Byte(S[0])] = '\') Then
    Delete(S, Byte(S[0]), 1);

  UnPutSlash := S;

END;

{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Function  PutDot(                    S         : STRING  ) : STRING;

[PARAMETERS]

S           Source String to modify

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

PutSlash
UnPutSlash
UnPutDot

[EXAMPLE]

-}

Function PutDot(                       S         : STRING       ) : STRING;

BEGIN

  If (Pos('.', S) = 0) Then
    PutDot := S + '.'
  Else
    PutDot := S;

END;

{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Function  UnPutDot(                  S         : STRING  ) : STRING;

[PARAMETERS]

S           Source String to modify

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

PutSlash
UnPutSlash
PutDot

[EXAMPLE]

-}

Function UnPutDot(                     S         : STRING       ) : STRING;

BEGIN

  If (S[0] > #0) AND
     (S[Byte(S[0])] = '.') Then
    Delete(S, Byte(S[0]), 1);

  UnPutDot := S;

END;

{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Function  FileExist(                 fn        : PathStr ) : BOOLEAN;

[PARAMETERS]

fn          ?

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-}

Function FileExist(                    fn        : PathStr      ) : BOOLEAN;

Var

  reFirst : SearchRec;

BEGIN

  FillChar( reFirst, SizeOf(SearchRec), 0 );
  FindFirst( fn, ReadOnly OR Hidden OR SysFile OR Archive, reFirst );
  FileExist := (DosError = 0);

END;

{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Function  GetFileTime(               fn        : PathStr ) : LONGINT;

[PARAMETERS]

fn          ?

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-}

Function GetFileTime(                  fn        : PathStr      ) : LONGINT;

Var

  reSearch : SearchRec;

BEGIN

  FillChar( reSearch, SizeOf(SearchRec), 0 );
  FindFirst( fn, AnyFile, reSearch );

  If (reSearch.Name <> '') Then
    GetFileTime := reSearch.Time
  Else
    GetFileTime := 0;

END;

{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Function  GetFileAttr(               fn        : PathStr ) : WORD;

[PARAMETERS]

fn          ?

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-}

Function GetFileAttr(                  fn        : PathStr      ) : WORD;

Var

  F    : FILE;
  Attr : WORD;

BEGIN

  If FileExist( fn ) Then
  BEGIN

    Assign(F, fn);
    GetFAttr(F, Attr);
    GetFileAttr := Attr;

  END
  Else
    GetFileAttr := 0;

END;

{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Function  GetFileSize(               fn        : PathStr ) : LONGINT;

[PARAMETERS]

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-}

Function GetFileSize(                  fn        : PathStr      ) : LONGINT;

Var

  reSearch : SearchRec;

BEGIN

  FillChar( reSearch, SizeOf(SearchRec), 0 );
  FindFirst( fn, AnyFile, reSearch );

  If (reSearch.Name <> '') Then
    GetFileSize := reSearch.Size
  Else
    GetFileSize := 0;

END;

{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Function  DirExist(                  stDir     : DirStr  ) : BOOLEAN;

[PARAMETERS]

stDir       Source Directory to Test Existance of

[RETURNS]

Whether or not the Indicated Directory Exists

[DESCRIPTION]

Tests the Indicated Source Directory to determine whether or not that
Sub-Directory Exists.  If so, returns TRUE, otherwise returns FALSE that
the Sub-Directory did not Exist.

[SEE-ALSO]

DirEmpty
PredDir
InDir
MkSubDir

[EXAMPLE]

-}

Function DirExist(                     stDir     : DirStr       ) : BOOLEAN;

Var

  DirAttr : WORD;
  fiTemp  : File;

BEGIN

  If Pos( '.', stDir ) = 0 Then
    Assign( fiTemp, stDir + '.' )
  Else
    Assign( fiTemp, stDir );

  GetFAttr( fiTemp, DirAttr );

  If ( DosError <> 0 ) Then
    DirExist := False
  Else
    DirExist := ( (DirAttr AND Directory) <> 0 );

END;

{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Function  DirEmpty(                  stDir     : DirStr  ) : BOOLEAN;

[PARAMETERS]

stDir       ?

[RETURNS]

Whether or not the Indicated Directory was Empty

[DESCRIPTION]

Tests the Sub-Directory indicated and determines if any files are contained
within it.  If so, returns FALSE else returns TRUE that Dir was Empty.

[SEE-ALSO]

DirExist
PredDir
InDir
MkSubDir

[EXAMPLE]

delete
-}

Function DirEmpty(                     stDir     : DirStr       ) : BOOLEAN;

Var

  reSearch : SearchRec;
  Count    : BYTE;

BEGIN

  stDir := PutSlash(stDir);
  Count := 0;

  FindFirst( stDir + '*.*', AnyFile, reSearch );

  While (Count < 2) AND
        (DosError <> 18) AND
        (reSearch.Attr AND Directory = Directory) Do
  BEGIN

    Inc(Count);
    FindNext( reSearch );

  END;

  DirEmpty := (Count = 2) AND (DosError = 18);
  DosError := 0;

END;


{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Function  EraseDir(                  stDir     : DirStr  ) : BOOLEAN;

[PARAMETERS]

stDir       SubDirectory to Empty

[RETURNS]

Whether or not the Indicated Directory was erased Successfully

[DESCRIPTION]

This function Deletes every File contained in the Source Sub-Directory
and returns whether or not the action was Successful.

[SEE-ALSO]

DirExist
PredDir
InDir
MkSubDir

[EXAMPLE]

delete
-}

Function  EraseDir(                  stDir     : DirStr  ) : BOOLEAN;

VAR

  SR  : SearchRec;
  F   : FILE;

BEGIN

  stDir := PutSlash( stDir );

  FindFirst( stDir+'*.*', AnyFile, SR );

  While DosError = 0 Do
  BEGIN

    Assign( F, SR.Name );
    Erase( F );
    FindNext( SR );

  END;  { While DosError }

END;  { EraseDir }

{───────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Function  PredDir(                   stDir     : DirStr  ) : DirStr;

[PARAMETERS]

stDir       ?

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

DirExist
DirEmpty
InDir
MkSubDir

[EXAMPLE]

-}

Function PredDir(                      stDir     : DirStr       ) : DirStr;

Var

  L1 : BYTE;

BEGIN

  stDir := PutSlash(stDir);

  L1 := Pred(Length(stDir));
  While (L1 > 2) AND (stDir[L1] <> '\') Do
    Dec(L1);

  If (L1 > 2) Then
    Delete( stDir, Succ(L1), Byte(stDir[0]) - L1 );

  PredDir := stDir;

END;

{───────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Function  InDir(                     stDir     : DirStr  ) : DirStr;

[PARAMETERS]

stDir       ?

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

DirExist
DirEmpty
PredDir
MkSubDir

[EXAMPLE]

-}

Function InDir(                        stDir     : DirStr       ) : DirStr;

Var

  L1 : INTEGER;

BEGIN

  stDir := PutSlash(stDir);

  L1 := Pred(Byte(stDir[0]));
  While (L1 > 2) AND (stDir[L1] <> '\') Do
    Dec(L1);

  If (L1 > 2) Then
    InDir := Copy( stDir, Succ(L1), Pred(Byte(stDir[0]) - L1) )
  Else
    InDir := stDir;

END;

{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Procedure MkSubDir(                  S         : STRING  );

[PARAMETERS]

S           Name of New SubDirectory (With or Without Trailing BackSlash)

[RETURNS]

(None)

[DESCRIPTION]

Takes care of handling the task of Creating a Sub-Directory with or
without the requirement of having to have a trailing BackSlash ("\")
in the New Directory Name.

[SEE-ALSO]

DirExist
DirEmpty
PredDir
InDir

[EXAMPLE]

  MkSubDir( 'C:\TEMP1' );
  MkSubDir( 'C:\TEMP2\' );

  (Both actions will create SubDirectories successfully - if disk space)
-}

Procedure MkSubDir(                    S         : STRING       );

Var

  Path  : STRING;
  IOErr : WORD;

BEGIN

  REPEAT

    {$I-}
    MkDir( S );
    IOErr := IOResult;
    {$I+}

    If (IOErr <> 0) Then
    BEGIN

      Path := UnPutSlash( PredDir( S ) );
      MkSubDir( Path );

    END;

  UNTIL (IOErr = 0);

  {error 3 = path not found}

END;

{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Function  MaskWildcards(             fn        : PathStr;
                                     fnMask    : PathStr ) : PathStr;

[PARAMETERS]

fn          ?
fnMask      ?

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-}

Function MaskWildcards(                fn        : PathStr;
                                       fnMask    : PathStr      ) : PathStr;

Var

  poFn    : BYTE;
  poMask  : BYTE;
  poFnDot : BYTE;
  seDir   : DirStr;
  neFn    : PathStr;

BEGIN

  {---------------------}
  { Setup fn and fnMask }
  {---------------------}

  If (fnMask = '') Then
  BEGIN

    MaskWildcards := fn;
    Exit;

  END;

  {--------------------------------}
  { Get starting point of filename }
  {--------------------------------}

  seDir := PredDir( fn );

  poFn := Pos(seDir, fn);
  If poFn <> 0 Then
    Inc( poFn, Length(seDir) )
  Else
  BEGIN

    seDir := '';
    poFn  := 1;

  END;

  {----------------------------------}
  { Find location of dot in filename }
  {----------------------------------}

  poFnDot := poFn;
  While (fn[poFnDot] <> '.') AND
        (poFnDot < Length(fn)) Do
    Inc(poFnDot);
  If fn[poFnDot] <> '.' Then
    poFnDot := 0;

  poMask := Pos('.', fnMask);
  If poMask = 0 Then
    fnMask := fnMask + '.';

  {------------}
  { Begin mask }
  {------------}

  poMask := 1;
  neFn := '';

  While (poMask <= Length(fnMask)) Do
  BEGIN

    If (fnMask[poMask] <> '?') AND
       (fnMask[poMask] <> '*') AND
       (fnMask[poMask] <> '.') Then

    BEGIN

      neFn := neFn + fnMask[poMask];
      Inc(poMask);

      If (fn[poFn] <> '.') Then
        Inc(poFn);

    END
    Else
    BEGIN

      Case fnMask[poMask] of

        '.' :

          BEGIN

            Inc(poMask);

            While (fn[Pred(poFn)] <> '.') AND
                  (poFn <= Length(Fn)) Do
              Inc(poFn);

            neFn := neFn + '.';

          END;

       {-----}

       '?' :

         BEGIN

           If fn[poFn] <> '.' Then
           BEGIN

             neFn := neFn + fn[poFn];

             Inc(poFn);

           END;

           Inc(poMask);

         END;

       {-----}

       '*' :  { any zero or more characters in this position }

         BEGIN

           While (fnMask[poMask] <> '.') AND
                 (poMask <= Length(fnMask)) Do
             Inc(poMask);

           While (fn[poFn] <> '.') AND
                 (poFn <= Length(Fn)) Do
           BEGIN

             neFn := neFn + fn[poFn];
             Inc(poFn);

           END;

         END;

       {-----}

      End;

    END;

  END;

  MaskWildcards := seDir + neFn;

END;

{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Procedure FileCRC16(                 FName     : STRING;
                                 Var Result    : WORD );

[PARAMETERS]

FName       Name of Source File to CRC
Result      VAR Modified 16-Bit CRC Checksum of Source File

[RETURNS]

(Function : None)
(Var      : (Result) Modified 16-Bit CRC Checksum of Source File)

[DESCRIPTION]

WARNING: File MUST Exist as there is NO Error Checking on this.

[SEE-ALSO]

FileCRC32

[EXAMPLE]

-}

Procedure FileCRC16(                 FName     : STRING;
                                 Var Result    : WORD );

Type

  TBuffer = Array[0..0] of BYTE;
  PBuffer = ^TBuffer;

Var

  fiBuf      : FILE;
  Buf        : PBuffer;
  Count      : WORD;
  L1         : WORD;
  NumRead    : WORD;

BEGIN

  If NOT FileExist(FName) Then
    Exit;

  Assign( fiBuf, FName );
  Reset( fiBuf, 1 );

  Count := $FFF8;
  If (MaxAvail < Count) Then
    Count := MaxAvail;

  GetMem( Buf, Count );

  Result := $FFFF;

  REPEAT

    BlockRead( fiBuf, Buf^, Count, NumRead );

    For L1 := 1 to NumRead Do
      CRC16Char( Char(Buf^[L1]), Result );

  UNTIL (NumRead = 0);

  FreeMem( Buf, Count );

  Close( fiBuf );

END;

{────────────────────────────────────────────────────────────────────────────}

{-

[FUNCTION]

Procedure FileCRC32(                 FName     : STRING;
                                 Var Result    : LONGINT );

[PARAMETERS]

FName       Name of Source File to CRC
Result      VAR 32-Bit CRC Checksum of Source File

[RETURNS]

(Function : None)
(Var      : (Result) 32-Bit CRC Checksum of Source File)

[DESCRIPTION]

WARNING: File MUST Exist as there is NO Error Checking on this.

[SEE-ALSO]

FileCRC16

[EXAMPLE]

-}

Procedure FileCRC32(                 FName     : STRING;
                                 Var Result    : LONGINT );

Type

  TBuffer = Array[0..0] of BYTE;
  PBuffer = ^TBuffer;

Var

  fiBuf      : FILE;
  Buf        : PBuffer;
  Count      : WORD;
  L1         : WORD;
  NumRead    : WORD;

BEGIN

  If NOT FileExist(FName) Then
    Exit;

  Assign( fiBuf, FName );
  Reset( fiBuf, 1 );

  Count := $FFF8;
  If (MaxAvail < Count) Then
    Count := MaxAvail;

  GetMem( Buf, Count );

  Result := $FFFFFFFF;

  REPEAT

    BlockRead( fiBuf, Buf^, Count, NumRead );

    For L1 := 1 to NumRead Do
      CRC32Char( Char(Buf^[L1]), Result );

  UNTIL (NumRead = 0);

  FreeMem( Buf, Count );

  Close( fiBuf );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  GetVolLabel(            Drive          : BYTE      ) : STRING;

[PARAMETERS]

Drive       Source Drive Number (0=Default)

[RETURNS]

The Volume Label of the Selected Drive

[DESCRIPTION]

Retrieves the Volume Label String from the selected Drive.
If there was an Error the String comes back empty.

[SEE-ALSO]

GetFileSysType
DOS_GetMediaID { VDOS }
DOS_SetMediaID { VDOS }

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  S := GetVolLabel( 0 );

  { S comes back as whatever the current drive Volume Label is }

END;

-*)

Function  GetVolLabel(            Drive          : BYTE      ) : STRING;

VAR
  Info  : WORD;
  Ser   : LONGINT;
  Vol,
  Ftype : STRING;

BEGIN

  If DOS_GetMediaID( Drive, Info, Ser, Vol, FType ) = $00 Then
    GetVolLabel := Vol
  Else
    GetVolLabel := '';

END;  {  GetVolLabel }

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  GetFileSysType(         Drive          : BYTE      ) : STRING;

[PARAMETERS]

Drive       Source Drive Number (0=Default)

[RETURNS]

File System Type Text of the selected Drive

[DESCRIPTION]

Retrieves the File System Type String from the selected Drive.
If there was an Error the String comes back empty.

[SEE-ALSO]

GetVolLabel
DOS_GetMediaID { VDOS }
DOS_SetMediaID { VDOS }

[EXAMPLE]

VAR
  S : STRING;

BEGIN

  S := GetFileSysType( 0 );

  { S = 'FAT16' - for this example }

END;

-*)

Function  GetFileSysType(         Drive          : BYTE      ) : STRING;

VAR
  Info  : WORD;
  Ser   : LONGINT;
  Vol,
  Ftype : STRING;

BEGIN

  If DOS_GetMediaID( Drive, Info, Ser, Vol, FType ) = $00 Then
    GetFileSysType := FType
  Else
    GetFileSysType := '';

END;  { GetFileSysType }
{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  DriveExist(                Drive     : CHAR    ) : BOOLEAN;

[PARAMETERS]

Drive       Drive letter to test existance of

[RETURNS]

Whether or not the indicated drive exists

[DESCRIPTION]

Tests the indicated drives to determine whether or not that it exists or
ready.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  DriveExist(                Drive     : CHAR    ) : BOOLEAN;
BEGIN

  DriveExist := DiskSize( Byte(UpCase(Drive)) - 64 ) <> -1;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  DeviceExist(                Name      : STRING  ) : BOOLEAN;

[PARAMETERS]

Name        Name of device to check

[RETURNS]

Whether or not the indicated device exists

[DESCRIPTION]

Tests the indicated device to determine whether or not it exist or is a
device.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  DeviceExist(                Name      : STRING  ) : BOOLEAN;

{$IFNDEF OS2}

Var

  F : File;
  N : Integer Absolute F;
  R : Registers;

BEGIN

  DeviceExist := False;
  Assign( F, Name );
  Reset( F );

  If IOResult <> 0 Then
    Exit;

  R.AX := $4400;
  R.BX := N;
  R.ES := $00;  { Load with 00 to avoid GPF in win/dpmi }
  R.DS := $00;

  Intr( $21, R );

  DeviceExist := (R.DX and $80) <> 0;  { check if 8th bit is set (device) }
  Close( F );

END;

{$ELSE}

BEGIN

  DeviceExist := FALSE;

END;

{$ENDIF}

{────────────────────────────────────────────────────────────────────────── }

(*

Function TextSeek(                Var F         : TEXT;
                                      NewPos    : LONGINT ) : WORD;


Var

  Err    : WORD;
  CurPos : LONGINT;

BEGIN

  If TextRec(F).Mode=fmInput Then
  BEGIN

    ASM

      MOV Err, 0

      MOV AX, $4201
      MOV BX, TextRec(F).Handle
      MOV CX, 0
      MOV DX, 0
      INT 21h

      JNC @@OK
        2
      MOV Err, AX

      JMP @@out

     @@ok:

      MOV word PTR [CurPos  ], AX
      MOV word PTR [CurPos+2], DX

     @@out:

    END;

    Dec( CurPos, TextRec(F).BufEnd );

    CurPos := NewPos-CurPos;

    If CurPos>=0 and (CurPos<TextRef(F).BufEnd) Then
      TextRec(F).BufEnd := CurPos
    ELSE
    BEGIN

      ASM

        MOV AX, $4200
        MOV BX, TextRec(F).Handle
        MOV CX, word PTR [CurPos+2]
        MOV DX, word PTR [CurPos  ]
        INT 21h

        JNC @@out2



        @@out2:

      END;

      TextRec( F ).BufEnd := 0;
      TextRef( F ).BufPos := 0;

    END;

  END
  ELSE
    TextSeek := $FFFF;

END;

*)




Function  GetDirFromPath(            Path      : STRING  ) : STRING;

Var

  Dir  : DirStr;
  Name : NameStr;
  Ext  : ExtStr;

BEGIN

  FSplit( Path, Dir, Name, Ext );

  GetDirFromPath := Dir;

END;

Function  GetNameFromPath(           Path      : STRING  ) : STRING;

Var

  Dir  : DirStr;
  Name : NameStr;
  Ext  : ExtStr;

BEGIN

  FSplit( Path, Dir, Name, Ext );

  GetNameFromPath := Name;

END;


Function  GetExtFromPath(            Path      : STRING  ) : STRING;

Var

  Dir  : DirStr;
  Name : NameStr;
  Ext  : ExtStr;

BEGIN

  FSplit( Path, Dir, Name, Ext );

  GetExtFromPath := Ext;

END;


Function  RemoveExtraSlash(          Path      : STRING  ) : STRING;

BEGIN

  If ( Path[ Length(Path) ] = '\'    ) and
     ( length(Path) > 1              ) and
     ( Path[ length(Path)-1 ] <> ':' ) Then

     Delete( Path, Length(Path), 1 );

  RemoveExtraSlash := Path;

END;


{────────────────────────────────────────────────────────────────────────────}
{────────────────────────────────────────────────────────────────────────────}

BEGIN
END.